El Mac 1/Magazine.iso/EL MAC 1/Shareware/HyperCard/XCMD Docs/CompileIt! Source Code/CompileItDraw

Text File | 1995-08-20 | 8.6 KB | 239 lines | [TEXT/ttxt]

global TempRect:R[8],colorBlack:R,ColorBorder:R,CommandKeyWasOrIsDown:B
global Color:R[6]
global tool1:I
Global MyEventRecord:R,TheMouseLoc:L,TheTicks:L,TheMsg:L,TheModifiers:I
on CompileItDraw
  hide menubar
  put false into CommandKeyWasOrIsDown
  put MakeWindow("Draw",0,0,512,342,0) into MyWind
  setPort myWind
  DrawButton
  repeat until CommandKeyWasOrIsDown
    get HandleEvent()
  end repeat
  DisposeWindow MyWind
  show menubar
end CompileItDraw

------------LIBRARY ROUTINES-----------------
function HandleButton clickH,clickV
  return GetBtn(ClickH,ClickV)
end HandleButton

function MakeWindow WindowName,rect1,rect2,rect3,rect4,procId
  -- to dispose of the window, use DisposCWindow with the result of
  -- this function.
  put NewPtr(8) into MyRectPtr
  put rect2 into MyRectPtr@.integerType[1]
  put rect1 into MyRectPtr@.integerType[2]
  put rect4 into MyRectPtr@.integerType[3]
  put rect3 into MyRectPtr@.integerType[4]
  get NewCWindow(NIL, myRectPtr@,WindowName,true,procId,-1,true,nil)
  disposPtr myRectPtr
  return it
end MakeWindow


function WithinRect h,v,r1,r2,r3,r4
  put h*1 into hh
  put v*1 into vv
  put r1*1 into rr1
  put r2*1 into rr2
  put r3*1 into rr3
  put r4*1 into rr4
  if (hh≥rr1 and vv≥rr2) and (hh≤rr3 and vv≤rr4) then return true
  else return false
end WithinRect

function GetBTN h,v
  if WithinRect(h,v,83,0,106,21) then return "9 false"
  if WithinRect(h,v,38,0,61,21) then return "8 false"
  if WithinRect(h,v,60,0,83,21) then return "7 false"
  if WithinRect(h,v,0,42,30,64) then return "6 true"
  if WithinRect(h,v,0,84,30,106) then return "5 true"
  if WithinRect(h,v,0,63,30,85) then return "4 true"
  if WithinRect(h,v,0,21,30,43) then return "3 true"
  if WithinRect(h,v,29,21,349,208) then return "2 false"
  if WithinRect(h,v,0,0,512,342) then return "1 false"
  return 0
end GetBtn

function GetRect bNum
  if bNum = "9" then return "83,0,106,21"
  if bNum = "8" then return "38,0,61,21"
  if bNum = "7" then return "60,0,83,21"
  if bNum = "6" then return "0,42,30,64"
  if bNum = "5" then return "0,84,30,106"
  if bNum = "4" then return "0,63,30,85"
  if bNum = "3" then return "0,21,30,43"
  if bNum = "2" then return "29,21,349,208"
  if bNum = "1" then return "0,0,512,342"
  return "THAT BUTTON DOES NOT EXIST"
end GetRect

on DrawButton
  put GetResource("PICT",25095) into ButtonPicHandle
  DrawPicture ButtonPicHandle, ButtonPicHandle@@.picFrame
  put  GetResource("PICT",7478) into ButtonPicHandle
  DrawPicture ButtonPicHandle, ButtonPicHandle@@.picFrame
  put  GetResource("PICT",15297) into ButtonPicHandle
  DrawPicture ButtonPicHandle, ButtonPicHandle@@.picFrame
  put  GetResource("PICT",1953) into ButtonPicHandle
  DrawPicture ButtonPicHandle, ButtonPicHandle@@.picFrame
  put  GetResource("PICT",29464) into ButtonPicHandle
  DrawPicture ButtonPicHandle, ButtonPicHandle@@.picFrame
  put  GetResource("PICT",11999) into ButtonPicHandle
  DrawPicture ButtonPicHandle, ButtonPicHandle@@.picFrame
  put  GetResource("PICT",7280) into ButtonPicHandle
  DrawPicture ButtonPicHandle, ButtonPicHandle@@.picFrame
  put  GetResource("PICT",16202) into ButtonPicHandle
  DrawPicture ButtonPicHandle, ButtonPicHandle@@.picFrame
  put  GetResource("PICT",3082) into ButtonPicHandle
  DrawPicture ButtonPicHandle, ButtonPicHandle@@.picFrame
end DrawButton

on xMouseDown ml, IsActivate, CmdKeyWasDown, ShiftKeyWasDown, CapsLockKeyWasDown, OptionKeyWasDown, ControlKeyWasDown
  if CmdKeyWasdown then
    put true into CommandKeyWasOrIsDown
    exit xMouseDown
  end if
  put TheMouseLoc.integerType[2] into h
  put TheMouseLoc.integerType[1] into v
  get HandleButton(h,v)
  if it="2 false" then
    DoDraw TheMouseLoc,ShiftKeyWasDown
  else if it="3 true" then put 1 into tool1
  else if it="4 true" then put 3 into tool1
  else if it="5 true" then put 3 into tool1
  else if it="6 true" then put 2 into tool1
  else if it="7 false" then
    if OptionKeyWasDown then PickAColor ShiftKeyWasDown
    else
      put 32767 into Color.integerType[1]
      put 32767 into Color.integerType[2]
      put 32767 into Color.integerType[3]
    end if
  else if it="8 false" then
    if OptionKeyWasDown then PickAColor ShiftKeyWasDown
    else
      put 0 into Color.integerType[1]
      put 0 into Color.integerType[2]
      put 0 into Color.integerType[3]
    end if
  else if it="9 false" then
    if OptionKeyWasDown then PickAColor ShiftKeyWasDown
    else
      put -1 into Color.integerType[1]
      put -1 into Color.integerType[2]
      put -1 into Color.integerType[3]
    end if
  end if
end xMouseDown

on xMouseUp TheMouseLoc, IsActivate, CmdKeyWasDown, ShiftKeyWasDown, CapsLockKeyWasDown, OptionKeyWasDown, ControlKeyWasDown
end xMouseUp

on xKeyDown TheKey, IsActivate, CmdKeyWasDown, ShiftKeyWasDown, CapsLockKeyWasDown, OptionKeyWasDown, ControlKeyWasDown
end xKeyDown

on xKeyUp TheKey, IsActivate, CmdKeyWasDown, ShiftKeyWasDown, CapsLockKeyWasDown, OptionKeyWasDown, ControlKeyWasDown
end xKeyUp

on xAutoKey TheKey, IsActivate, CmdKeyWasDown, ShiftKeyWasDown, CapsLockKeyWasDown, OptionKeyWasDown, ControlKeyWasDown
end xAutoKey

on xUpdateWindow WindowPtr
end xUpdateWindow

on xDiskInserted DriveNumber, ResultCode
end xDiskInserted

on xActivate WindowPtr
end xActivate

on xAppleEvent p1, p2
end xAppleEvent

on xOpertatingSystem
end xOpertatingSystem

on xNullEvent
end xNullEvent

Function HandleEvent
  get WaitNextEvent(2, MyEventRecord,1000, NIL)
  put MyEventRecord.where into TheMouseLoc
  put MyEventRecord.when into TheTicks
  put MyEventRecord.Message into TheMsg
  put MyEventRecord.modifiers into TheModifiers
  put (BitAnd(TheModifiers,1)≠0) into IsActivate
  put (BitAnd(TheModifiers,128)≠0) into ButtonWasUp
  put (BitAnd(TheModifiers,256)≠0) into CmdKeyWasDown
  put (BitAnd(TheModifiers,512)≠0) into ShiftKeyWasDown
  put (BitAnd(TheModifiers,1024)≠0) into CapsLockKeyWasDown -- alphaLock
  put (BitAnd(TheModifiers,2048)≠0) into OptionKeyWasDown
  put (BitAnd(TheModifiers,4096)≠0) into ControlKeyWasDown
  if it then
    if MyEventRecord.integerType=1 then xMouseDown TheMouseLoc, IsActivate,CmdKeyWasDown,ShiftKeyWasDown,CapsLockKeyWasDown,OptionKeyWasDown,ControlKeyWasDown
    if MyEventRecord.integerType=2 then xMouseUp TheMouseLoc, IsActivate,CmdKeyWasDown,ShiftKeyWasDown,CapsLockKeyWasDown,OptionKeyWasDown,ControlKeyWasDown
    if MyEventRecord.integerType=3 then xKeyDown theMsg.charType[3], IsActivate,CmdKeyWasDown,ShiftKeyWasDown,CapsLockKeyWasDown,OptionKeyWasDown,ControlKeyWasDown
    if MyEventRecord.integerType=4 then xKeyUp theMsg.charType[3], IsActivate,CmdKeyWasDown,ShiftKeyWasDown,CapsLockKeyWasDown,OptionKeyWasDown,ControlKeyWasDown
    if MyEventRecord.integerType=5 then xAutoKey theMsg.charType[3], IsActivate,CmdKeyWasDown,ShiftKeyWasDown,CapsLockKeyWasDown,OptionKeyWasDown,ControlKeyWasDown
    if MyEventRecord.integerType=6 then xUpdateWindow theMsg -- theMsg is ponter to window
    if MyEventRecord.integerType=7 then xDiskInserted LoWord(theMsg),hiWord(theMsg)
    if MyEventRecord.integerType=8 then xActivate theMsg -- pointer to window
    if MyEventRecord.integerType=10 then xAppleEvent theMsg,TheMouseLoc
    if MyEventRecord.integerType=-15 then xOpertatingSystem

  else xNullEvent
end HandleEvent




on DoDraw TheMouseLoc,ShiftKeyWasDown
  RGBForeColor color
  Set cursor to 2
  repeat while button()
  end repeat
  getMouse new
  put TheMouseLoc into TempRect.longIntType[1]
  put new into TempRect.longIntType[2]
  if ShiftKeyWasDown then -- ha ha ha! Only a line!
    moveTo tempRect.integerType[2],tempRect.integerType[1]
    LineTo tempRect.integerType[4],tempRect.integerType[3]
  else
    if tool1=0 then exit doDraw
    else if Tool1=1 then
      PaintRect TempRect -- Rectangle
      RGBForeColor ColorBorder
      frameRect TempRect -- border
    else if Tool1=2 then
      PaintRoundRect TempRect,15,15 -- Rounded Rectangle
      RGBForeColor ColorBorder
      frameRoundRect TempRect,15,15 -- border
    else if Tool1=3 then
      PaintOval TempRect -- oval
      RGBForeColor ColorBorder
      frameOval TempRect -- border
    end if
  end if
  set cursor to "arrow"
end DoDraw

Global APoint:L
on PickAColor ShiftKeyWasDown
  RGBForeColor colorBlack -- No!!! Don't fade out!!!
  -- first save window, for redraw...
  put openPicture(thePort@.portRect) into temp
  copybits thePort@.portbits,theport@.portbits,theport@.portRect,thePort@.portRect,0,nil
  closePicture
  put -1 into APoint.integerType[1]
  put -1 into APoint.integerType[2]
  debug checkpoint
  if ShiftKeyWasDown then
    get GetColor(aPoint,"Pick A Color To Frame With:",ColorBorder,ColorBorder)
  else get GetColor(aPoint,"Pick A Color To Draw With:",color,color)
  drawPicture temp,thePort@.portRect
  killPicture temp
end PickAColor